home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pull70.zip / PULLSHEL.ZIP / PULLDATA.PAS next >
Pascal/Delphi Source File  |  1993-06-21  |  11KB  |  321 lines
  1. { ========================================================================== }
  2. { PullData.pas - User Statistics for data-entry windows.   ver 7.0, 06-21-93 }
  3. {                                                                            }
  4. { This file contains all the data to configure the data-entry fields in      }
  5. { data windows or work windows.                                              }
  6. {   Copyright (c) 1988,1993 James H. LeMay, All rights reserved.             }
  7. { ========================================================================== }
  8.  
  9. {$i pulldefs.inc }
  10.  
  11. {$define UseMsgLineCode }
  12.  
  13. UNIT PullData;
  14.  
  15. INTERFACE
  16.  
  17. uses
  18.   Crt,Qwik,Wndw,Pull,PullStat;
  19.  
  20. { ================ Set up variables for data windows here: ================= }
  21. { Place your variables names here to interface with the menus.               }
  22. { Careful! -- there's NO type checking for parameters in Transfer.  You MUST }
  23. { be certain case statement, DataWndw, and TypeOfData all match.  Be         }
  24. { especially careful of string lengths that are too long.  They can be no    }
  25. { longer than DataStrSize.                                                   }
  26. { -------------------------------------------------------------------------- }
  27.  
  28. const
  29.   aByte:    byte    = 100;
  30.   aInteger: integer = 200;
  31.  
  32. type
  33.   { Work window data entry names. }
  34.   DataEntryNames = (NoDE,aIntegerDE);
  35.  
  36. var
  37.   DataEntryOattr,          { Output attribute }
  38.   DataEntryIattr,          { Input  attribute }
  39.   DataWndwIattr,           { Input  attribute }
  40.   DataWndwOattr,           { Output attribute }
  41.   DataWndwBattr:  byte;    { Border attribute }
  42.   DataWndwBrdr:   Borders;
  43.  
  44.  
  45. IMPLEMENTATION
  46.  
  47. uses
  48.   WUtil,
  49.   {$ifdef UseStrg }
  50.   Strg;
  51.   {$else }
  52.   Strs;
  53.   {$endif }
  54.  
  55. { ================ Set up your Error Message Lines here: =================== }
  56. { Error Messages are used for indicating that data entry was invalid or out  }
  57. { of range.  ErrMsgLine[1] is reserved for custom error messages that you    }
  58. { can create at runtime.  Messages up to InvalidEM are reserved and must     }
  59. { match those in PULL.PAS.                                                   }
  60. { -------------------------------------------------------------------------- }
  61. type
  62.   ErrMsgNames = (NoEM,UserEM,InvalidEM,MyEM);
  63.  
  64. {$ifdef UseMsgLineCode }
  65. procedure GetErrMsgs;
  66. begin
  67.   AutoNumLock := false;   { If true, turns on NumLock on with data entry }
  68.   CapsLockCol := 41;      { First column for ' CAPS NUM SCROLL ' on MsgLine. }
  69.  
  70.   ErrMsgLine[ord(InvalidEM)]:=' Invalid entry.             ESC-acknowledge';
  71.   ErrMsgLine[ord(MyEM)]     :=' This indicates an error.   ESC-acknowledge';
  72. end;
  73.  
  74. {$endif UseMsgLineCode }
  75.  
  76. procedure MakeErrMsg (Low,High: longint);
  77. begin
  78.   {$ifdef UseMsgLineCode }
  79.   DataPad.ErrMsg := ord(UserEM);
  80.   ErrMsgLine[ord(UserEM)] :=
  81.     'Range: '+StrL(Low)+' to '+StrL(High)+'.  Press ESC';
  82.   {$endif }
  83. end;
  84.  
  85. { ====================== Data Entry Range Checking ========================= }
  86. { These procedures are completely defined by the user.  They may not even be }
  87. { necessary if the string entered is satisfactory as a valid number.  The    }
  88. { calls must be forced to FAR because they are called indirectly.            }
  89. { "Translate" can alter each key from the keyboard before it gets evaluated. }
  90. { "Verify" will check the range or even completely alter the entire string.  }
  91. { -------------------------------------------------------------------------- }
  92.  
  93. { -------------------- Data Window Data Entry Checking --------------------- }
  94. procedure CheckAbyte; far;
  95. begin
  96.   with DataPad do
  97.     if ((Bdata<20) or (Bdata>50)) then
  98.       MakeErrMsg (20,50);
  99. end;
  100.  
  101. { -------------------- Work Window Data Entry Checking --------------------- }
  102.  
  103. procedure TranslateCase; far;
  104. begin
  105.   if not ExtKey then
  106.     Key := upcase(Key);        { Simple upper case translation }
  107. end;
  108.  
  109. procedure VerifyAinteger; far;
  110. begin
  111.   with DataPad do
  112.     if ((Idata=0) or (Idata>200)) then
  113.       MakeErrMsg (1,200);
  114. end;
  115.  
  116. { ======================== GetUserDataEntry ================================ }
  117. { The major configurations for all menus go here.  The program first clears  }
  118. { all RECORD values to $00.  The values below will set new values. Therefore,}
  119. { setting RECORD values to "false", nil, or the like is not necessary.       }
  120. { -------------------------------------------------------------------------- }
  121.  
  122. { Code saving utilities: }
  123. procedure GetDataWndw (Index: word);
  124. begin
  125.   DWI := Index;
  126.   TopDataWndw := DataWndw^[DWI];
  127. end;
  128.  
  129. procedure SaveDataWndw;
  130. begin
  131.   DataWndw^[DWI] := TopDataWndw;
  132. end;
  133.  
  134. procedure GetDataEntry (Index: word);
  135. begin
  136.   DEI := Index;
  137.   TopEntry := DataEntry^[DEI];
  138. end;
  139.  
  140. procedure SaveDataEntry;
  141. begin
  142.   DataEntry^[DEI] := TopEntry;
  143. end;
  144.  
  145. procedure GetDataEntryStats;
  146. begin
  147.  
  148.   { ------------- Set up your PULL-DOWN Data Windows here: ----------------- }
  149.   { Justification will default with numbers right justified and string to  }
  150.   { the left if none is specified.                                         }
  151.  
  152.   with TopDataWndw,TopDataWndw.Entry do
  153.     begin
  154.  
  155.       GetDataWndw (ord(aByteDW));         { Just gets cleared TopDataWndw }
  156.       VarAddr       := @aByte;
  157.     { TypeOfData    := Bytes; }           { This is the default }
  158.       Field         := 3;
  159.     { JustifyOutput := Right; }           { This is the default }
  160.     { MsgLineNum    := ord(DE_ML); }      { This is the default }
  161.     { HelpWndwNum   := ord(DataWndwHW); } { This is the default }
  162.       SaveDataWndw;                       { Saves it in the heap }
  163.  
  164.   end;  { with }
  165.  
  166.   { ------------------------ Work Window Data Entry ------------------------ }
  167.   AutoTab := true;    { After entry, tabs to next one in sequence }
  168.   with DataPad do
  169.     if QvideoMode=Mono then
  170.          Hattr := LightGrayBG
  171.     else Hattr := White+CyanBG; { Optional Attribute of Data Entry hilite }
  172.                                 { Use SameAttr if not desired }
  173.   with TopEntry do
  174.     begin
  175.  
  176.       GetDataEntry (ord(aIntegerDE));
  177.       VarAddr     := @aInteger;
  178.       TypeOfData  := Integers;
  179.       Row         := 4;
  180.       Col         := 11;
  181.       Field       := 4;
  182.       MaxField    := 3;
  183.       CheckRangeProc := VerifyAinteger;
  184.     { MsgLineNum  := ord(DE_ML); }      { This is the default }
  185.     { HelpWndwNum := ord(DataWndwHW); } { This is the default }
  186.       SaveDataEntry;
  187.  
  188.     end;
  189.  
  190. end;  { procedure GetDataEntryStats }
  191.  
  192. { =================== Data Entry Initialization Code ======================= }
  193. { The following code initializes all of the stats for the data entry windows }
  194. { and the work window data entry fields.  There is no need to edit this      }
  195. { Except for the default colors in SetDefaultColors.                         }
  196. { -------------------------------------------------------------------------- }
  197.  
  198. procedure AllocateHeap;
  199. begin
  200.   if HeapOK (sizeof(DataWndws)) then
  201.     GetMem (DataWndw,SizeOf(DataWndws));
  202.   FillB    (DataWndw^,SizeOf(DataWndws),0);
  203.   if HeapOK (sizeof(DataEntries)) then
  204.     GetMem (DataEntry,SizeOf(DataEntries));
  205.   FillB    (DataEntry^,SizeOf(DataEntries),0);
  206. end;
  207.  
  208. procedure SetDefaultColors;
  209. begin
  210.   { ------------------ Set up your colors and borders here: ---------------- }
  211.   if QvideoMode=Mono then
  212.     begin
  213.       DataEntryIattr := LightGray;         { Input  attribute }
  214.       DataEntryOattr := White;             { Output attribute }
  215.       DataWndwIattr  := White;             { Input  attribute }
  216.       DataWndwOattr  := LightGrayBG;       { Output attribute }
  217.     end
  218.   else
  219.     begin
  220.       DataEntryIattr := Yellow+MagentaBG;  { Input  attribute }
  221.       DataEntryOattr := Black+LightGrayBG; { Output attribute }
  222.       DataWndwIattr  := Black+BrownBG;     { Input  attribute }
  223.       DataWndwOattr  := Yellow+BlackBG;    { Output attribute }
  224.     end;
  225.   DataWndwBattr  := Black+BrownBG;     { Border attribute }
  226.   DataWndwBrdr   := HdoubleBrdr;
  227. end;
  228.  
  229. procedure InitDataColors;
  230. var  i: word;
  231. begin
  232.   for i:=1 to NumOfDataWndws do
  233.     with TopDataWndw,TopDataWndw.Entry do
  234.       begin
  235.         GetDataWndw (i);
  236.         Iattr := DataWndwIattr;   { Input  attribute }
  237.         Oattr := DataWndwOattr;   { Output attribute }
  238.         Battr := DataWndwBattr;   { Border attribute }
  239.         SaveDataWndw;
  240.       end;
  241.   for i:=1 to NumOfDataEntries do
  242.     with TopEntry do
  243.       begin
  244.         GetDataEntry (i);
  245.         Iattr := DataEntryIattr;  { Input  attribute }
  246.         Oattr := DataEntryOattr;  { Output attribute }
  247.         SaveDataEntry;
  248.       end;
  249. end;
  250.  
  251. function GetJustify (Justify: DirType; TOD: TypeOfDataType): DirType;
  252. begin
  253.   if Justify=NoDir then
  254.     begin
  255.       if TOD<=UserNums then
  256.            GetJustify := Right   { for nums }
  257.       else GetJustify := Left;   { for chars and strings }
  258.     end
  259.   else GetJustify:=Justify;
  260. end;
  261.  
  262. function GetSetName (SN: SetNames; TOD: TypeOfDataType): SetNames;
  263. begin
  264.   if SN=NoSet then
  265.     case TOD of
  266.       Bytes,Words:         GetSetName := UnsignedSet;
  267.       ShortInts..LongInts: GetSetName := SignedSet;
  268.       Reals:               GetSetName := RealSet;
  269.     else
  270.       GetSetName := CharSet;
  271.     end
  272.   else GetSetName:=SN;
  273. end;
  274.  
  275. procedure InitDataDefaults;
  276. var i: word;
  277. begin
  278.   for i:=1 to NumOfDataWndws do
  279.     with TopDataWndw,TopDataWndw.Entry do
  280.       begin
  281.         GetDataWndw (i);
  282.         Border  := DataWndwBrdr;
  283.         SetName := GetSetName (SetName,TypeOfData);
  284.         Row := 1;
  285.         Col := 2;
  286.         if MaxField=0 then
  287.           MaxField := Field;
  288.         JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
  289.         if MsgLineNum=0 then
  290.           MsgLineNum := ord(DW_ML);
  291.         if HelpWndwNum=0 then
  292.           HelpWndwNum := ord(DataWndwHW);
  293.         SaveDataWndw;
  294.       end;
  295.   for i:=1 to NumOfDataEntries do
  296.     with TopEntry do
  297.       begin
  298.         GetDataEntry (i);
  299.         SetName := GetSetName (SetName,TypeOfData);
  300.         if MaxField=0 then
  301.           MaxField := Field;
  302.         JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
  303.         if MsgLineNum=0 then
  304.           MsgLineNum := ord(DE_ML);
  305.         if HelpWndwNum=0 then
  306.           HelpWndwNum := ord(DataWndwHW);
  307.         SaveDataEntry;
  308.       end;
  309. end;
  310.  
  311. BEGIN
  312.   AllocateHeap;
  313.   SetDefaultColors;
  314.   InitDataColors;
  315.   {$ifdef UseMsgLineCode }
  316.   GetErrMsgs;
  317.   {$endif }
  318.   GetDataEntryStats;
  319.   InitDataDefaults;
  320. END.
  321.